home *** CD-ROM | disk | FTP | other *** search
/ Atari Gold / Atari Gold.iso / om_basic / vollver3.03 / is_lib.bas < prev    next >
Encoding:
BASIC Source File  |  1988-10-01  |  9.2 KB  |  193 lines
  1. 63000 END ' Isam-Library. Stand 05.07.88
  2. 63001 DEF PROC Is_Open(Handle%L,Is_Name$,Laenge%L,Filenr%L,Anzahl%L)
  3. 63005 Is_Namtest: DIM Is_Such$(1):Is_Fnr%L(Handle%L)=Filenr%L:Is_Nam$(Handle%L)=Is_Name$
  4. 63010 Is_Anz%L(Handle%L)=Anzahl%L:Is_Rcl%L(Handle%L)=Laenge%L:Is_Open: RETURN
  5. 63015 '
  6. 63020 DEF PROC Is_Close(Handle%L)
  7. 63025 Is_Close: RETURN
  8. 63030 '
  9. 63035 DEF PROC Is_Update(Handle%L)
  10. 63040 Is_Close:Is_Open: RETURN
  11. 63045 '
  12. 63050 DEF PROC Is_Backup(Is_Von$,Is_Nach$,Is_Name$,Anzahl%L): LOCAL I%L
  13. 63055 Is_Namtest:Is_Von$=Is_Von$+Is_Name$:Is_Nach$=Is_Nach$+Is_Name$
  14. 63060 COPY Is_Von$+".DAT" TO Is_Nach$+".BAK"
  15. 63065 FOR I%L=1 TO Anzahl%L
  16. 63070 COPY Is_Von$+FN Is_Index$(I%L) TO Is_Nach$+".B"+ RIGHT$( STR$(100+I%L),2)
  17. 63075 NEXT : RETURN
  18. 63080 '
  19. 63085 DEF PROC Is_Kill(Is_Von$,Is_Name$,Anzahl%L): LOCAL I%L
  20. 63090 Is_Namtest:Is_Von$=Is_Von$+Is_Name$: KILL Is_Von$+".DAT"
  21. 63095 FOR I%L=1 TO Anzahl%L: KILL Is_Von$+FN Is_Index$(I%L): NEXT : RETURN
  22. 63100 '
  23. 63105 DEF FN Is_Index$(I%L)=".I"+ RIGHT$( STR$(100+I%L),2)
  24. 63110 '
  25. 63115 DEF PROC Is_Namtest
  26. 63120 IF INSTR(Is_Name$,".") OR INSTR(Is_Name$,"*") OR INSTR(Is_Name$,"?") THEN ERROR 64 ELSE RETURN
  27. 63125 '
  28. 63130 DEF PROC Is_Open: LOCAL I%L,Filenr%L=Is_Fnr%L(Handle%L)
  29. 63135 OPEN "R",Filenr%L,Is_Nam$(Handle%L)+".DAT",Is_Rcl%L(Handle%L): FOR I%L=1 TO Is_Anz%L(Handle%L)
  30. 63140 OPEN "R",Filenr%L+I%L,Is_Nam$(Handle%L)+FN Is_Index$(I%L),2+Is_Len%L(Handle%L,I%L): NEXT
  31. 63145 FIELD Filenr%L,6 AS Is_$: GET Is_Fnr%L(Handle%L),1
  32. 63150 IF EOF(Filenr%L) THEN LSET Is_$= MKIL$($20002)+ MKI$(0)
  33. 63155 Is_Next%L(Handle%L)= CVI(Is_$):Is_Free%L(Handle%L)= CVI( MID$(Is_$,3)):Is_Size%L(Handle%L)= CVI( MID$(Is_$,5))
  34. 63160 ON Handle%L GOTO Is_1,Is_2,Is_3,Is_4,Is_5,Is_6,Is_7,Is_8,Is_9,Is_10
  35. 63200-Is_0
  36. 63205 FIELD Is_Fnr%L(0),0
  37. 63210 '
  38. 63215 '
  39. 63220 RETURN
  40. 63225-Is_1
  41. 63230 FIELD Is_Fnr%L(1),0
  42. 63235 '
  43. 63240 '
  44. 63245 RETURN
  45. 63250-Is_2
  46. 63255 FIELD Is_Fnr%L(2),0
  47. 63260 '
  48. 63265 '
  49. 63270 RETURN
  50. 63275-Is_3
  51. 63280 FIELD Is_Fnr%L(3),0
  52. 63285 '
  53. 63290 '
  54. 63295 RETURN
  55. 63300-Is_4
  56. 63305 FIELD Is_Fnr%L(4),0
  57. 63310 '
  58. 63315 '
  59. 63320 RETURN
  60. 63325-Is_5
  61. 63330 FIELD Is_Fnr%L(5),0
  62. 63335 '
  63. 63340 '
  64. 63345 RETURN
  65. 63350-Is_6
  66. 63355 FIELD Is_Fnr%L(6),0
  67. 63360 '
  68. 63365 '
  69. 63370 RETURN
  70. 63375-Is_7
  71. 63380 FIELD Is_Fnr%L(7),0
  72. 63385 '
  73. 63390 '
  74. 63395 RETURN
  75. 63400-Is_8
  76. 63405 FIELD Is_Fnr%L(8),0
  77. 63410 '
  78. 63415 '
  79. 63420 RETURN
  80. 63425-Is_9
  81. 63430 FIELD Is_Fnr%L(9),0
  82. 63435 '
  83. 63440 '
  84. 63445 RETURN
  85. 63450-Is_10
  86. 63455 FIELD Is_Fnr%L(10),0
  87. 63460 '
  88. 63465 '
  89. 63470 RETURN
  90. 63475 '
  91. 63480 DEF PROC Is_Close: LOCAL I%L
  92. 63485 FOR I%L=0 TO Is_Anz%L(Handle%L): CLOSE Is_Fnr%L(Handle%L)+I%L: NEXT : RETURN
  93. 63490 '
  94. 63495 DEF PROC Is_Entry(Handle%L,Nr%L,Position%L,Laenge%L,Typ%L)
  95. 63500 Is_Len%L(Handle%L,Nr%L)=Laenge%L:Is_Pos%L(Handle%L,Nr%L)=Position%L:Is_Typ%L(Handle%L,Nr%L)=Typ%L: RETURN
  96. 63505 '
  97. 63510 DEF PROC Is_Insert(Handle%L): LOCAL Filenr%L=Is_Fnr%L(Handle%L),I%L,Von%L,Bis%L,Mitte%L,R%L
  98. 63515 FIELD Filenr%L,Is_Rcl%L(Handle%L) AS Is_Field$:Is_Field2$=Is_Field$
  99. 63520 R%L=Is_Free%L(Handle%L): IF R%L=Is_Next%L(Handle%L) THEN
  100. 63525 Is_Free%L(Handle%L)=R%L+1:Is_Next%L(Handle%L)=R%L+1 ELSE
  101. 63530 GET Filenr%L,R%L:Is_Free%L(Handle%L)= CVI(Is_Field$): LSET Is_Field$=Is_Field2$
  102. 63535 ENDIF PUT Filenr%L,R%L
  103. 63540 FOR I%L=1 TO Is_Anz%L(Handle%L):Is_Rec$= MKI$(R%L)+ MID$(Is_Field2$,Is_Pos%L(Handle%L,I%L)+1,Is_Len%L(Handle%L,I%L))
  104. 63545 LSET Is_Field$=Is_Field2$:Is_Search:Is_Move(Mitte%L,Is_Size%L(Handle%L)+1)
  105. 63550 NEXT :Is_Size%L(Handle%L)=Is_Size%L(Handle%L)+1:Is_Update_Len: RETURN
  106. 63555 '
  107. 63560 DEF PROC Is_Replace(Handle%L,Old%L): LOCAL Filenr%L=Is_Fnr%L(Handle%L),I%L,Von%L,Bis%L,Mitte%L,Mitte2%L,R%L
  108. 63565 FIELD Filenr%L,Is_Rcl%L(Handle%L) AS Is_Field$:Is_Field2$=Is_Field$
  109. 63570 GET Filenr%L,Old%L:Is_Field3$=Is_Field$
  110. 63575 FOR I%L=1 TO Is_Anz%L(Handle%L)
  111. 63580 LSET Is_Field$=Is_Field3$:Is_Search: WHILE CVI(Is_$)<>Old%L:Mitte%L=Mitte%L+1: GET Filenr%L+I%L,Mitte%L: WEND
  112. 63585 Mitte2%L=Mitte%L: LSET Is_Field$=Is_Field2$:Is_Search:Mitte%L=Mitte%L+(Mitte%L>Mitte2%L)
  113. 63590 Is_Rec$= MKI$(Old%L)+ MID$(Is_Field2$,Is_Pos%L(Handle%L,I%L)+1,Is_Len%L(Handle%L,I%L)):Is_Move(Mitte%L,Mitte2%L)
  114. 63595 NEXT : LSET Is_Field$=Is_Field2$: PUT Filenr%L,Old%L: RETURN
  115. 63600 '
  116. 63605 DEF PROC Is_Delete(Handle%L,Old%L): LOCAL Filenr%L=Is_Fnr%L(Handle%L),I%L,Von%L,Bis%L,Mitte%L,Is_Rec$,Is_T$
  117. 63610 FIELD Filenr%L,Is_Rcl%L(Handle%L) AS Is_Field$: GET Filenr%L,Old%L:Is_Field2$=Is_Field$
  118. 63615 FOR I%L=1 TO Is_Anz%L(Handle%L)
  119. 63620 LSET Is_Field$=Is_Field2$:Is_Search: WHILE CVI(Is_$)<>Old%L:Mitte%L=Mitte%L+1: GET Filenr%L+I%L,Mitte%L: WEND
  120. 63625 Is_Rec$= CHR$(0)*(Is_Len%L(Handle%L,I%L)+1+1):Is_Move(Is_Size%L(Handle%L),Mitte%L)
  121. 63630 NEXT : LSET Is_Field$= MKI$(Is_Free%L(Handle%L)): PUT Filenr%L,Old%L:Is_Free%L(Handle%L)=Old%L
  122. 63635 Is_Size%L(Handle%L)=Is_Size%L(Handle%L)-1:Is_Update_Len: RETURN
  123. 63640 '
  124. 63645 DEF PROC Is_Update_Len
  125. 63650 FIELD Filenr%L,6 AS Is_Field$
  126. 63655 LSET Is_Field$= MKI$(Is_Next%L(Handle%L))+ MKI$(Is_Free%L(Handle%L))+ MKI$(Is_Size%L(Handle%L))
  127. 63660 PUT Filenr%L,1: RETURN
  128. 63665 '
  129. 63670 DEF PROC Is_Search: LOCAL Flag%L
  130. 63675 FIELD Filenr%L,Is_Pos%L(Handle%L,I%L),Is_Len%L(Handle%L,I%L) AS Is_Such$:Is_Such2$=Is_Such$
  131. 63680 Von%L=1:Bis%L=Is_Size%L(Handle%L): FIELD Filenr%L+I%L,2,Is_Len%L(Handle%L,I%L) AS Is_$
  132. 63685 WHILE Von%L<=Bis%L:Mitte%L=(Von%L+Bis%L) SHR 1: GET Filenr%L+I%L,Mitte%L
  133. 63690 ON Is_Typ%L(Handle%L,I%L) GOTO Is_Search1,Is_Search2
  134. 63695 Flag%L=Is_Such2$>Is_$: GOTO Is_Search3
  135. 63700-Is_Search1:Is_Such$(0)=Is_Such2$:Is_Such$(1)=Is_$: SORT Is_Such$(0)
  136. 63705 Flag%L=Is_Such$(0)<>Is_Such2$: GOTO Is_Search3
  137. 63710-Is_Search2:Flag%L= VAL(Is_Such2$)> VAL(Is_$)
  138. 63715-Is_Search3: IF Flag%L THEN Von%L=Mitte%L+1 ELSE Bis%L=Mitte%L-1
  139. 63720 WEND :Mitte%L=Von%L: GET Filenr%L+I%L,Mitte%L: FIELD Filenr%L+I%L,2 AS Is_$: RETURN
  140. 63725 '
  141. 63730 DEF PROC Is_Search(Handle%L,I%L,R R%L): LOCAL Filenr%L=Is_Fnr%L(Handle%L),Von%L,Bis%L,Mitte%L
  142. 63735 IF I%L=-1 THEN Mitte%L=Is_Last%L(Handle%L)-1
  143. 63740 IF I%L=0 THEN Mitte%L=Is_Last%L(Handle%L)+1
  144. 63745 IF I%L>0 THEN Is_Lasti%L(Handle%L)=I%L:Is_Search
  145. 63750 R%L=Mitte%L: IF R%L=0 THEN Mitte%L=1 ELSE IF R%L>Is_Size%L(Handle%L) THEN Mitte%L=Is_Size%L(Handle%L):R%L=0
  146. 63755 I%L=Is_Lasti%L(Handle%L):Is_Last%L(Handle%L)=Mitte%L
  147. 63760 IF R%L THEN GET Filenr%L+I%L,R%L: FIELD Filenr%L+I%L,2 AS Is_$:R%L= CVI(Is_$) ENDIF RETURN
  148. 63765 '
  149. 63770 DEF PROC Is_Move(Von%L,Bis%L): LOCAL Filenr%L=Filenr%L+I%L,R1%L,R2%L,L%L=Is_Len%L(Handle%L,I%L)+1+1,P%L
  150. 63775 IF ABS(Von%L-Bis%L)>100 THEN
  151. 63780 CLOSE Filenr%L: OPEN "R",Filenr%L,Is_Nam$(Handle%L)+FN Is_Index$(I%L),L%L*50
  152. 63785 FIELD Filenr%L,L%L*50 AS Is_$:R1%L=(Von%L-1)\50+1:R2%L=(Bis%L-1)\50+1
  153. 63790 P%L=((Von%L-1) MOD 50)*L%L: GET Filenr%L,R1%L
  154. 63795 IF Von%L<Bis%L THEN
  155. 63800 Is_Such2$= LEFT$(Is_$,P%L)+Is_Rec$+ MID$(Is_$,P%L+1)
  156. 63805 WHILE R1%L<R2%L: LSET Is_$=Is_Such2$: PUT Filenr%L,R1%L:R1%L=R1%L+1: GET Filenr%L,R1%L:Is_Such2$= RIGHT$(Is_Such2$,L%L)+Is_$: WEND
  157. 63810 P%L=((Bis%L-1) MOD 50)*L%L
  158. 63815 LSET Is_$= LEFT$(Is_Such2$,P%L+L%L)+ MID$(Is_Such2$,P%L+L%L*2+1): PUT Filenr%L,R2%L
  159. 63820 ELSE
  160. 63825 Is_Such2$= LEFT$(Is_$,P%L+L%L)+Is_Rec$+ MID$(Is_$,P%L+L%L+1)
  161. 63830 WHILE R1%L>R2%L: RSET Is_$=Is_Such2$: PUT Filenr%L,R1%L:R1%L=R1%L-1: GET Filenr%L,R1%L:Is_Such2$=Is_$+ LEFT$(Is_Such2$,L%L): WEND
  162. 63835 P%L=((Bis%L-1) MOD 50)*L%L
  163. 63840 LSET Is_$= LEFT$(Is_Such2$,P%L)+ MID$(Is_Such2$,P%L+L%L+1): PUT Filenr%L,R2%L
  164. 63845 ENDIF
  165. 63850 CLOSE Filenr%L: OPEN "R",Filenr%L,Is_Nam$(Handle%L)+FN Is_Index$(I%L),L%L
  166. 63855 ELSE
  167. 63860 FIELD Filenr%L,L%L AS Is_$: FOR R1%L=Von%L TO Bis%L STEP SGN(Bis%L-Von%L+.1)
  168. 63865 GET Filenr%L,R1%L:Is_Such$=Is_$: LSET Is_$=Is_Rec$: PUT Filenr%L,R1%L: SWAP Is_Such$,Is_Rec$: NEXT
  169. 63870 ENDIF RETURN
  170. 63875 '
  171. 63880 DEF PROC Is_Reorg(Handle%L): LOCAL Filenr%L=Is_Fnr%L(Handle%L),I%L,L%L,R%L
  172. 63885    IF Is_Size%L(Handle%L)>Is_Reorg%L THEN STOP ' nach is_reorg: CLEAR!
  173. 63890    Is_Reorg%L=Is_Size%L(Handle%L):L%L=Is_Next%L(Handle%L)-1:Is_Reorgm%L= MAX(Is_Reorgm%L,L%L)
  174. 63895    DIM Is_Reorg$(Is_Reorg%L-1),Is_Reorg#(Is_Reorg%L-1),Is_Reorg%(Is_Reorg%L-1)
  175. 63900    DIM Is_Reorg%F(Is_Reorgm%L): FOR I%L=2 TO L%L:Is_Reorg%F(I%L)=1: NEXT
  176. 63905    R%L=Is_Free%L(Handle%L): FIELD Filenr%L,2 AS Is_$
  177. 63910    WHILE R%L>1 AND R%L<=L%L:Is_Reorg%(R%L)=0: GET Filenr%L,R%L:R%L= CVI(Is_$): WEND
  178. 63915    IF R%L<>L%L+1 THEN STOP ' Stammdatei ist quatsch mit Soße
  179. 63920    FOR Nr%L=1 TO Is_Anz%L(Handle%L)
  180. 63925       I%L=0: FOR R%L=2 TO L%L: IF Is_Reorg%F(R%L) THEN Is_Reorg%(I%L)=R%L:I%L=I%L+1 ENDIF NEXT
  181. 63930       IF I%L<>Is_Reorg%L THEN STOP ' Stammdatei ist quatsch mit Soße
  182. 63935       FIELD Filenr%L,Is_Pos%L(Handle%L,Nr%L),Is_Len%L(Handle%L,Nr%L) AS Is_$
  183. 63940       FOR R%L=0 TO Is_Reorg%L-1: GET Filenr%L,Is_Reorg%(R%L):Is_Reorg$(R%L)=Is_$: NEXT
  184. 63945       R%L=Is_Typ%L(Handle%L,Nr%L)
  185. 63950       IF R%L=0 THEN SORT ASC Is_Reorg$(0) TO Is_Reorg%(0)
  186. 63955       IF R%L=1 THEN SORT Is_Reorg$(0) TO Is_Reorg%(0)
  187. 63960       IF R%L=2 THEN FOR I%L=0 TO Is_Reorg%L-1:Is_Reorg#(I%L)= VAL(Is_Reorg$(I%L)+"#"): NEXT
  188. 63965       IF R%L=2 THEN SORT Is_Reorg#(0) TO Is_Reorg%(0)
  189. 63970       FIELD Filenr%L+Nr%L,Is_Len%L(Handle%L,Nr%L)+2 AS Is_$
  190. 63975       FOR R%L=0 TO Is_Reorg%L-1: LSET Is_$= MKI$(Is_Reorg%(R%L))+Is_Reorg$(R%L): PUT Filenr%L+Nr%L,R%L+1: NEXT
  191. 63980    NEXT Nr%L
  192. 63985 RETURN
  193. ə